home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / partysex.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-05-31  |  9.2 KB  |  288 lines
  1. 10  ' THIS GAME WAS WRITTEN BY PAUL MCKNIGHT WHILE STANDING AT AN IBM PARTS
  2. 20  'COUNTER WATCHING A BEAUTIFUL WOMAN SELECT AND DELIVER THE PARTS HE HAD
  3. 30  'ORDERED
  4. 40  '
  5. 50  'MAY BE REPRODUCED FOR ANY NON-COMMERCIAL PURPOSE
  6. 60  ' APRIL, 1982
  7. 61  CLS: LOCATE 5,21:PRINT"*******FREE SOFTWARE*******"
  8. 62  LOCATE 7,15: PRINT "PARTS VERSION 1.0, 80 COLUMN MONOCHROME"
  9. 63  LOCATE 9,5:PRINT "Paul McKnight, the author of this program, is a firm advocate of Public Domain"
  10. 64  PRINT "software. Please copy this program and pass it around to all your ADULT friends."
  11. 65  LOCATE 15,27: PRINT "Paul McKnight"
  12. 66  LOCATE 16,29: PRINT "Box 3392"
  13. 67  LOCATE 17,23: PRINT "Gaithersburg, MD 20878"
  14. 68  LOCATE 20,21: PRINT "PRESS SPACEBAR TO CONTINUE..."
  15. 69  INK$=INKEY$: IF INK$<>" " THEN 69
  16. 70  OPTION BASE 1
  17. 80  TIMESEED1=ASC(RIGHT$(TIME$,2))
  18. 90  TIMESEED2=100*ASC(MID$(TIME$,4,2))
  19. 100  RANDOMIZE (TIMESEED1+TIMESEED2)
  20. 110  NMAX=9
  21. 120  DIM BACK(2)
  22. 130  DIM PLAYER$(2)
  23. 140  DIM STATUS(2,NMAX)
  24. 150  DIM ARRAY$(2,3,NMAX)
  25. 160  ' THIS THREE-DIMENSIONAL ARRAY HOLDS THE PART NUMBER - PART NAME DATA BASE
  26. 170  ' FIRST DIMENSION DENOTES THE PLAYER (1 OR 2)
  27. 180  ' SECOND DIMENSION HOLDS 1) PLAYER ROUND 1 PART NAMES
  28. 190  '                        2) PLAYER ROUND 2 PART NAMES
  29. 200  '                        3) PLAYER PART NUMBERS
  30. 210  ' THIRD DIMENSION HOLDS THE ACTUAL NAME OR NUMBER SELECTED BY THE OTHER 2
  31. 220  ' EXAMPLES: ARRAY$(2,3,1) HOLDS THE PART NUMBER FOR ITEM 1 OF PLAYER 2
  32. 230  '           ARRAY$(1,2,7) HOLDS THE NAME OF PART 7 FOR PLAYER 1 IN ROUND 2
  33. 240  SCREEN 0,0,0,0: WIDTH 80
  34. 250  M1$="IS": M2$="IT": M3$="PEN": UPAS$="": PAS1$="SEX":PAS2$="sex":  M4$="CL"
  35. 260  CLS: BEEP
  36. 270  KEY OFF
  37. 280  LOCATE 10,10
  38. 290  PRINT "WELCOME TO PARTS, AN EXCITING ADULT INTIMACY GAME"
  39. 300  PRINT SPC(25);"I AM THE REFEREE..."
  40. 310  PRINT
  41. 320  LOCATE ,10
  42. 330  PRINT "Parts starts off a little bit like strip poker"
  43. 340  LOCATE ,10
  44. 350  PRINT "and gets heavier.  Therefore, it is password protected"
  45. 360  LOCATE ,10
  46. 370  PRINT "to keep out virgins and minors.": PRINT
  47. 380  LOCATE ,10
  48. 390  PRINT " To proceed, you will have to enter a password..."
  49. 400  FOR I=1 TO 3
  50. 410  A$=INKEY$: IF A$="" THEN 410
  51. 420  UPAS$=UPAS$+A$
  52. 430  NEXT I
  53. 440  IF UPAS$=PAS1$ OR UPAS$=PAS2$ THEN 490
  54. 450  CLS: PRINT "SORRY... WRONG PASSWORD...": FOR I=1 TO 1000: NEXT I
  55. 460  CHAIN "MENU"
  56. 470  '***************************************************
  57. 480  'ESTABLISH DATA BASE
  58. 490  BEEP:CLS
  59. 500  FOR I=1 TO 2: PRINT
  60. 510  PRINT SPC(20);"PLEASE ENTER NAME OF PLAYER NUMBER";I
  61. 520  LINE INPUT "                    NAME: ";PLAYER$(I)
  62. 530  IF PLAYER$(I)="" THEN 520
  63. 540  NEXT I
  64. 550  M5$="OR": M6$=M3$+M1$
  65. 560  CLS: PRINT "THANK YOU.  NOW I WANT BOTH OF YOU TO COUNT YOUR ITEMS"
  66. 570  PRINT "OF CLOTHING.  IF ONE OF YOU HAS MORE CLOTHING THAN THE"
  67. 580  PRINT "OTHER, PLEASE DISCARD ENOUGH SO THAT THE COUNT IS EQUAL."
  68. 590  M7$=M5$+M1$:M8$=M4$+M2$
  69. 600  PRINT
  70. 610  PRINT "NOW, WHEN YOU BOTH HAVE AN EQUAL NUMBER OF ITEMS OF CLOTHING,"
  71. 620  PRINT "PLEASE ENTER THAT NUMBER. (BETWEEN 1 AND 9)"
  72. 630  ITEM$=INPUT$(1)
  73. 640  M9$=M8$+M7$
  74. 650  TEMP=ASC(ITEM$)
  75. 660  IF TEMP<49 THEN PRINT "WE NEED AT LEAST ONE!": GOTO 610
  76. 670  IF TEMP>57 THEN PRINT "NO MORE THAN 9, PLEASE!": GOTO 610
  77. 680  BEEP
  78. 690  ITEMS=VAL(ITEM$)
  79. 700  FOR I=1 TO NMAX: READ ARRAY$(1,3,I),ARRAY$(2,3,I),ARRAY$(1,2,I)
  80. 710  ARRAY$(2,2,I)=ARRAY$(1,2,I)
  81. 720  NEXT I
  82. 730  DATA "1269024","1269521","FACE AND LIPS"
  83. 740  DATA "6520873","1174354","BUTTOCKS"
  84. 750  DATA "1132078","1606424","LEFT BREAST"
  85. 760  DATA "1269037","1269731","RIGHT LEG"
  86. 770  DATA "1269964","1269045","LEFT LEG"
  87. 780  DATA "1334531","1466650","EARS"
  88. 790  DATA "1269344","1269454","RIGHT BREAST"
  89. 800  DATA "1269880","1269901","NECK"
  90. 810  DATA "1236969","1269693","DUMMY"
  91. 820  CLS
  92. 830  FOR I=1 TO 2:PRINT
  93. 840  PRINT PLAYER$(I);", NOW I WANT YOU TO ENTER THE NAMES OF YOUR ITEMS"
  94. 850  PRINT "OF CLOTHING. (PRESS ENTER AFTER EACH ITEM NAME.)"
  95. 860  FOR K=1 TO ITEMS
  96. 870  PRINT K;
  97. 880  LINE INPUT "    "; TEMP$
  98. 890  IF TEMP$="" THEN LOCATE 4+K,1: GOTO 870
  99. 900  ARRAY$(I,1,K)=TEMP$
  100. 910  NEXT K
  101. 920  PRINT: PRINT "THANK YOU, ";PLAYER$(I)
  102. 930  BEEP: GOSUB 2110: CLS
  103. 940  NEXT I
  104. 950  FOR I=1 TO 2: PRINT
  105. 960  PRINT PLAYER$(I);", ARE YOU MALE OR FEMALE?"
  106. 970  PRINT "ENTER 6 IF MALE. ENTER 9 IF FEMALE."
  107. 980  TEMP$=INKEY$
  108. 990  IF TEMP$="6" THEN ARRAY$(I,2,9)=M6$: ARRAY$(I,2,3)="LEFT NIPPLE": ARRAY$(I,2,7)="RIGHT NIPPLE": GOTO 1030
  109. 1000  IF TEMP$="9" THEN ARRAY$(I,2,9)=M9$: GOTO 1030
  110. 1010  IF TEMP$="" THEN 980
  111. 1020  GOTO 970
  112. 1030  PRINT "THANK YOU, "; PLAYER$(I):PRINT: PRINT: PRINT
  113. 1040  NEXT I
  114. 1050  GOSUB 2110
  115. 1060  '***********************************************************
  116. 1070  REM HERE COMES THE MAIN LOOP
  117. 1080  FOR ROUND=1 TO 2
  118. 1090  GOSUB 2470 ' INITIALIZE ORDER STATUS ARRAY
  119. 1100  IF ROUND=2 THEN ITEMS=9
  120. 1110  '**************************
  121. 1120  FOR LOOP=1 TO (ITEMS+1): CLS
  122. 1130  PRINT SPC(25); "ROUND"; LOOP
  123. 1140  SOUND 1500,10
  124. 1150  FOR PAUSE=1 TO 500: NEXT PAUSE
  125. 1160  '**************
  126. 1170  FOR TURN= 1 TO 2
  127. 1180  IF TURN= 1 THEN OTHER= 2
  128. 1190  IF TURN= 2 THEN OTHER= 1
  129. 1200  IF LOOP= ITEMS+1 THEN GOSUB 1810: GOTO 1590
  130. 1210  CLS
  131. 1220  PRINT PLAYER$(TURN);", IT IS YOUR TURN TO ORDER A PART."
  132. 1230  PRINT "HERE IS A LIST OF ";PLAYER$(OTHER);"'S PART NUMBERS:"
  133. 1240  FOR N=1 TO ITEMS
  134. 1250  PRINT N,ARRAY$(OTHER,3,N),
  135. 1260  IF STATUS(OTHER,N)=1 THEN PRINT ARRAY$(OTHER,ROUND,N);"   *DELIVERED*":         GOTO 1290
  136. 1270  IF STATUS(OTHER,N)=2 THEN PRINT ARRAY$(OTHER,ROUND,N);"   *BACK-ORDERED*";
  137. 1280  PRINT "  "
  138. 1290  NEXT N
  139. 1300  PRINT "ENTER THE LINE NUMBER OF THE PART YOU WANT TO ORDER:"
  140. 1310  PRINT "(OR ENTER B TO CHECK ON YOUR BACK ORDERS):"
  141. 1320  TEMP$=INPUT$(1)
  142. 1330  IF TEMP$="B" OR TEMP$="b" THEN GOSUB 2160: GOTO 1210
  143. 1340  ARITEM$=STR$(ITEMS)
  144. 1350  ARITEM$=RIGHT$(ARITEM$,1)
  145. 1360  IF TEMP$<"1" OR TEMP$>ARITEM$ THEN 1300
  146. 1370  ORDER=VAL(TEMP$)
  147. 1380  PRINT ORDER
  148. 1390  PART$=ARRAY$(OTHER,ROUND,ORDER)
  149. 1400  IF STATUS(OTHER,ORDER)=1 THEN GOSUB 1780: GOTO 1300
  150. 1410  IF STATUS(OTHER,ORDER)=2 THEN GOSUB 1780: GOTO 1300
  151. 1420  PRINT "THANK YOU, ",PLAYER$(TURN): FOR PAUSE=1 TO 400: NEXT PAUSE
  152. 1430  SOUND 2000,5
  153. 1440  CLS: PRINT PLAYER$(OTHER);","
  154. 1450  PRINT PLAYER$(TURN);" HAS ORDERED YOUR ";PART$;"."
  155. 1460  PRINT "PRESS THE SPACEBAR IF YOU WANT TO DELIVER THE ORDER."
  156. 1470  PRINT "PRESS THE LETTER *B* TO BACK-ORDER IT..."
  157. 1480  TEMP$=INKEY$
  158. 1490  IF TEMP$=" " THEN 1520
  159. 1500  IF TEMP$="B" OR TEMP$="b" THEN 1560
  160. 1510  GOTO 1480
  161. 1520  GOSUB 2540 ' TELL OTHER TO DELIVER PART
  162. 1530  IF ROUND=2 THEN GOSUB 2030
  163. 1540  GOSUB 1920
  164. 1550  STATUS(OTHER,ORDER)=1: GOTO 1590
  165. 1560  STATUS(OTHER,ORDER)=2: SOUND 1000,7
  166. 1570  PRINT ARRAY$(OTHER,ROUND,ORDER);"   BACK-ORDERED"
  167. 1580  BACK(OTHER)=BACK(OTHER)+1: PRINT: PRINT
  168. 1590  FOR I=1 TO 600: NEXT I
  169. 1600  NEXT TURN
  170. 1610  '************
  171. 1620  NEXT LOOP
  172. 1630  '**************************
  173. 1640  ON ROUND GOTO 1650,1710
  174. 1650  CLS: PRINT "CONGRATULATIONS, YOU HAVE FINISHED PART 1 OF 'PARTS'."
  175. 1660  PRINT "NOW, BEFORE YOU GO ON TO PART 2, I ADVISE YOU TO GO TAKE"
  176. 1670  PRINT "A SHOWER TOGETHER AND GET EACH OTHER SQUEAKY CLEAN.  THE"
  177. 1680  PRINT "NEXT SESSION DEALS WITH PARTS OF YOUR BODIES INSTEAD OF"
  178. 1690  PRINT "PIECES OF YOUR CLOTHING."
  179. 1700  BACK(1)=0: BACK(2)=0: GOSUB 1920: GOTO 1730
  180. 1710  CLS: PRINT "I HOPE YOU HAVE ENJOYED PLAYING PARTS.  I HOPE YOU HAVE"
  181. 1720  PRINT "ENJOYED EACH OTHER.  HAVE A NICE NIGHT."
  182. 1730  NEXT ROUND
  183. 1740  '***************
  184. 1750  GOSUB 1920
  185. 1760  GOTO 2140
  186. 1770  '***********************************************************
  187. 1780  PRINT "THAT PART HAS ALREADY BEEN ORDERED."
  188. 1790  RETURN
  189. 1800  '**************************
  190. 1810  IF BACK(OTHER)=0 THEN PRINT PLAYER$(OTHER);" HAS NO BACK-ORDERS TO DELIVER.": GOSUB 2110: GOTO 1890
  191. 1820  CLS:
  192. 1830  PRINT PLAYER$(OTHER);", THIS IS THE LAST ROUND. IT'S TIME TO DELIVER"
  193. 1840  PRINT "ALL OF YOUR BACK-ORDERS:":PRINT: PRINT
  194. 1850  GOSUB 2390
  195. 1860  PRINT
  196. 1870  IF ROUND=2 THEN PRINT PLAYER$(TURN);" YOU KNOW WHAT TO DO WITH PARTS BY NOW..."
  197. 1880  GOSUB 1920
  198. 1890  RETURN
  199. 1900  '**************************
  200. 1910  'WAIT ROUTINE
  201. 1920  PRINT
  202. 1930  IF RND<0.8 THEN 1970
  203. 1940  K=INT(RND*9+1)
  204. 1950  ON K GOSUB  2580,2600,2620,2640,2660,2680,2700,2720,2750
  205. 1960  PRINT
  206. 1970  PRINT SPC(20); "HIT SPACEBAR TO PROCEED."
  207. 1980  TEMP$=INKEY$
  208. 1990  IF TEMP$=" " THEN RETURN
  209. 2000  GOTO 1980
  210. 2010  '***************************
  211. 2020  'MESSAGE TO GO WITH DELIVERED BODY PARTS
  212. 2030  PRINT: PRINT PLAYER$(TURN);", YOU ARE TO TOUCH, CARESS, MASSAGE, FONDLE,"
  213. 2040  PRINT "AND/OR KISS "; PLAYER$(OTHER);"'S ";PART$;". ";
  214. 2050  PRINT "  YOU CAN ALSO"
  215. 2060  PRINT "GO BACK AND PLAY WITH ANY PART ALREADY DELIVERED."
  216. 2070  PRINT "TAKE YOUR TIME. WHEN YOU BOTH AGREE, CONTINUE..."
  217. 2080  RETURN
  218. 2090  '**************************
  219. 2100  'THIS IS THE PAUSE SUBROUTINE
  220. 2110  FOR N=1 TO 1000: NEXT N: RETURN
  221. 2120  '********************************
  222. 2130  ' THIS IS THE LEGAL EXIT
  223. 2140  CHAIN "MENU"
  224. 2150  '''******************************
  225. 2160  ' BACK-ORDER CHECK ROUTINE
  226. 2170  IF BACK(OTHER)=0 THEN CLS: PRINT "THERE ARE NO PENDING BACK-ORDERS":            GOSUB 1920: RETURN
  227. 2180  GOSUB 2390
  228. 2190  PRINT
  229. 2200  PRINT PLAYER$(OTHER);", ENTER THE LINE NUMBER OF ANY BACK-ORDER YOU WISH TO DELIVER NOW."
  230. 2210  PRINT "HIT THE SPACEBAR IF YOU DON'T WANT TO DELIVER A BACK-ORDER."
  231. 2220  TEMP$=INKEY$
  232. 2230  IF TEMP$=" " THEN RETURN
  233. 2235  IF TEMP$<"1" OR TEMP$>"9" THEN 2220
  234. 2240  IF TEMP$="" THEN 2220
  235. 2250  BVAL=VAL(TEMP$)
  236. 2260  IF BVAL> ITEMS THEN 2200
  237. 2270  IF STATUS(OTHER,BVAL) >< 2 THEN PRINT "NOT BACK-ORDERED": GOTO 2200
  238. 2280  PRINT
  239. 2290  PART$=ARRAY$(OTHER,ROUND,BVAL)
  240. 2300  GOSUB 2540
  241. 2310  STATUS(OTHER,BVAL)=1
  242. 2320  IF TEMP$=" " THEN RETURN
  243. 2330  IF TEMP$="" THEN 2220
  244. 2340  BACK(OTHER)=BACK(OTHER)-1: PRINT: PRINT
  245. 2350  GOSUB 1920
  246. 2360  RETURN
  247. 2370  '***********************************
  248. 2380  ' LIST BACK-ORDERED ITEMS
  249. 2390  FOR N=1 TO ITEMS
  250. 2400  IF STATUS(OTHER,N)<> 2 THEN 2420
  251. 2410  PRINT N,ARRAY$(OTHER,ROUND,N);"   BACK-ORDERED"
  252. 2420  NEXT N
  253. 2430  RETURN
  254. 2440  '************************************
  255. 2450  'THIS SUBROUTINE WILL INITIALIZE THE STATUS ARRAY
  256. 2460  '0 IS NOT ORDERED  1 IS DELIVERED  2 IS BACK-ORDERED
  257. 2470  FOR I=1 TO 2
  258. 2480  FOR K=1 TO NMAX
  259. 2490  STATUS(I,K)=0
  260. 2500  NEXT K
  261. 2510  NEXT I
  262. 2520  RETURN
  263. 2530  '**************************************
  264. 2540  PRINT
  265. 2550  PRINT "O.K., ";PLAYER$(OTHER);", DELIVER YOUR ";PART$;" TO ";PLAYER$(TURN)
  266. 2560  RETURN
  267. 2570  '*************************************
  268. 2580  PRINT "I hear heavy breathing..."
  269. 2590  RETURN
  270. 2600  PRINT "I smell smoke. ";PLAYER$(OTHER);" must be getting hot..."
  271. 2610  RETURN
  272. 2620  PRINT "I hope no one has a heart attack..."
  273. 2630  RETURN
  274. 2640  PRINT "This is fun!"
  275. 2650  RETURN
  276. 2660  PRINT "I'm getting a little bit excited myself..."
  277. 2670  RETURN
  278. 2680  PRINT "Remember, I'm the referee and I get to watch everything..."
  279. 2690  RETURN
  280. 2700  PRINT "What a nice way to get acquainted..."
  281. 2710  RETURN
  282. 2720  IF BACK(OTHER)=0 THEN 2740
  283. 2730  PRINT "Remember, hands off the back-ordered parts!"
  284. 2740  RETURN
  285. 2750  IF ROUND=1 THEN 2770
  286. 2760  PRINT "Remember, don't play with any undelivered parts!"
  287. 2770  RETURN
  288.